home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / codeprnt / vbppdm / test2.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1994-02-20  |  2.5 KB  |  92 lines
  1. VERSION 2.00
  2. Begin Form Test2 
  3.    Caption         =   "Aardvark Software"
  4.    ClientHeight    =   5940
  5.    ClientLeft      =   1020
  6.    ClientTop       =   1455
  7.    ClientWidth     =   7305
  8.    Height          =   6315
  9.    Left            =   975
  10.    LinkTopic       =   "frmTest2"
  11.    ScaleHeight     =   5940
  12.    ScaleWidth      =   7305
  13.    Top             =   1125
  14.    Width           =   7395
  15.    Begin ComboBox cboType 
  16.       Height          =   300
  17.       Left            =   2040
  18.       TabIndex        =   1
  19.       Text            =   "Combo1"
  20.       Top             =   1260
  21.       Width           =   2895
  22.    End
  23.    Begin CommandButton Command1 
  24.       Caption         =   "Do It"
  25.       Height          =   495
  26.       Left            =   2160
  27.       TabIndex        =   0
  28.       Top             =   4560
  29.       Width           =   2535
  30.    End
  31.    Begin Label Label1 
  32.       Caption         =   "Type:"
  33.       Height          =   255
  34.       Left            =   360
  35.       TabIndex        =   2
  36.       Top             =   1320
  37.       Width           =   1095
  38.    End
  39. Option Explicit
  40. Dim LostFocusActive As Integer
  41. Dim BeepOnError As Integer
  42. 'General Routine for Hashing item's id
  43. Sub AddressItem (Item_ID As String, Hash As Integer)
  44. Dim i As Integer
  45. If Len(Item_ID) > 1 Then
  46.    Hash = 0
  47.    For i = 1 To Len(Item_ID)
  48.       Hash = Hash + Asc(Mid$(Item_ID, i, 1))
  49.    Next i
  50.    Hash = Hash Mod 17 ' a prime number
  51.    Select Case Item_ID
  52.    Case " " ' blank
  53.       Hash = 0
  54.    Case "0" To "9"
  55.       Hash = 1
  56.    Case Else
  57.       Hash = 2
  58.    End Select
  59. End If
  60. End Sub
  61. Sub cboType_LostFocus ()
  62. Dim Ans            As Integer
  63. Dim i              As Integer
  64. Dim lenType        As Integer
  65. Dim NewCode        As String
  66. Dim NewDescription As String
  67. If LostFocusActive <> -1 And LostFocusActive <> cboType.TabIndex Then Exit Sub
  68. LostFocusActive = -1
  69. If cboType.ListIndex > -1 Then Exit Sub  ' all ok
  70. NewDescription = cboType.Text
  71. If NewDescription = "" Then
  72.    If BeepOnError Then Beep
  73.    MsgBox "Type may not be blank"
  74.    cboType.SetFocus
  75.    LostFocusActive = cboType.TabIndex
  76.    Exit Sub
  77. End If
  78. ' a possible new value
  79. Ans = MsgBox(NewDescription & " is a new value, do you want to add it?", MB_YESNOCANCEL + MB_ICONQUESTION + MB_DEFBUTTON2)
  80. If Ans = IDNO Then ' he said no
  81.    cboType.SelStart = 0
  82.    cboType.SelLength = Len(cboType.Text)
  83.    cboType.SetFocus
  84.    LostFocusActive = cboType.TabIndex
  85.    Exit Sub
  86. ElseIf Ans = IDCANCEL Then
  87.    cboType.Text = ""
  88.    cboType.ListIndex = -1
  89.    Exit Sub
  90. End If
  91. End Sub
  92.